home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ShareWare OnLine 2
/
ShareWare OnLine Volume 2 (CMS Software)(1993).iso
/
prog
/
langwn23.zip
/
SAMPLE05.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-03-20
|
24KB
|
644 lines
'============================================================================
'============================================================================
' this sample has two demos:
' 1) subroutine IntButton illustrates the technique
' of starting a long running task and displaying an interrupt
' button to terminate that task. the "time out" feature of WinEvent is
' used to return control to your code if no events occur in 0.5 seconds.
' 2) subroutine GetScrollDemo illustrates how to dynamically
' add text to a list of scrollable text in a visible window.
' you must start QuickBASIC as follows: qb /ah /L langwin
' /L langwin parameter provides access to LangWin quicklib
' /ah parameter is needed to allow dynamic arrays > 64k.
DECLARE SUB IntButton () ' demo of interrupt button technique
DECLARE SUB GrowScrollDemo () ' demo of adding text to visible window
DECLARE FUNCTION VidType% () ' used to determine type of monitor
' must compile with qb /ah /L langwin
'$DYNAMIC make all arrays dynamic
DEFINT A-Z
'$INCLUDE: 'LANGWIN.BI' ' TYPE, DECLARE and COMMON definitions for LangWin.
' NOTE: LANGWIN.BI contains all definitions found
' in QB.BI, so include for QB.BI is not needed.
CLEAR , , 5000 ' set stack at 5000 bytes
'---------------------------------------------------------------
' first see if EGA or VGA monitor
mm = VidType
IF mm <> 3 AND mm <> 4 THEN
' monitor is not EGA/VGA
' take whatever actions necessary (error messages)
BEEP
PRINT "LangWin needs EGA or VGA, sorry ........"
END
END IF
'-----------------------------------------------------------------
' get attribute from current screen (row 1, col 1)
' so it can be restored upon exit
OrigAttr = SCREEN(1, 1, 1)
'-------------------------------------------------------------------
' if WIDTH command is used, it must be placed before call to LangWinInit
' because code in LangWinInit extracts max rows/cols from screen and saves
' in global variables. if WIDTH is used after LangWinInit, the global
' variable will not be set correctly.
WIDTH 80, 25
'----------------------------------------------------------------------
' these variables MUST be defined BEFORE call to LangWinInit.
' keep these as low as possible to conserve memory at run time.
MaxWindows = 8 ' max simultaneous open windows
MaxButtons = 30 ' max number of objects (incl lines with labels) active
MaxTextLines = 35 ' maximum number of text lines in any scrollable win
MaxTextWins = 5 ' max windows that can have scrollable text
' must be <= MaxWindows
LOCATE , , 0 ' start with hidden text cursor
'---------------------------------------------------------------------------
' LangWin only supports text mode. You MUST call the SCREEN 0 command BEFORE
' the call to LangWinInit. You can call SCREEN with a video page other than 0
' (i.e., SCREEN 0,,x,x where x is a page number supported by your system).
' Code in LangWinInit will determine which video page you are using and save
' the value in a global variable for use by other LangWin routines. If you
' call SCREEN 0 after LangWinInit and change the original video page, you'll
' get unpredictable results (i.e., LangWin will write to the original video
' page). However, you can use other video pages for functions not associated
' with your LangWin windows; just be sure to set the video page back to the
' original value defined below.
SCREEN 0, , 0, 0 ' LangWin ONLY supports text mode
' You MUST call the SCREEN command BEFORE LangWinInit
CALL LangWinInit ' initialize (if mouse exists, it will be displayed)
' if you get "subscript out of range" error while
' in this routine, be sure you called QB with /ah.
' then try reducing the value of MaxWindows.
' check the WIDTH command; reduce number of columns,
' and/or number of rows.
'-----------------------------------------------------------------------
' display "wallpaper"
IF HaveMouse THEN CALL HideMouseCursor ' first hide mouse pointer
CLS
CALL SetColor(8, 15)
FOR i = 1 TO MaxRows
LOCATE i, 1
PRINT STRING$(80, 178); ' can try 176, 177, or 178
NEXT
IF HaveMouse THEN CALL ShowMouseCursor ' display the mouse pointer
'====================================================================
CALL IntButton ' demo of technique to implement an interrupt button
CALL GrowScrollDemo ' demo of dynamically growing scrollable list
'=====================================================================
IF HaveMouse THEN HideMouseCursor ' we're done with the mouse
bbb = (OrigAttr AND &HF0) \ 16 ' mask & shift to get original background
fff = OrigAttr AND &HF ' mask to get original foreground
PALETTE ' restore original palette
CALL SetColor(fff, bbb) ' restore orig foreground/background
CLS
LOCATE , , 1 ' make text cursor visible
END
REM $STATIC
SUB GrowScrollDemo
' this routine shows an example of how you could dynamically
' add text to the bottom of an existing window containing scrollable
' text (using the GrowScrollText function).
' two windows are opened; one with buttons (EXIT, ADD, AUTO) and one
' with scrollable text.
' for each click on ADD button, dynamic text will be manually generated and
' added to the bottom of the visible scrollable text. when the scrollable
' text fills the window, it is scrolled up as new text is added to the bottom.
' clicking the AUTO button will cause text to be automatically added.
' (a STOP button will become active. click it to halt the process;
' else process will halt when array is filled).
' notice that the window to be modified (ie where the scrollable text
' is to be added) MUST be current when GrowScrollText is called.
' i've overlapped the text and buttons windows to show how the
' text window is given focus each time you click ADD to add a new line
' of text.
' this technique could be used if your program searches a file, data base,
' directory, etc. for specific data, and you want to dynamically display
' the extracted info in a scrollable window as the search progresses.
' call GrowScrollText each time a new entry is returned by your search
' routine. this will give the user feedback - they'll see the scrollable text
' growing as new entries are found.
' if you fill up the array (MaxTextLines), then GrowScrollText will
' return a -2 return code. in this case, you'll have to process
' the current array of scrollable text and perhaps give the
' user the option to continue the search (via a button) after
' all extracted data in this pass have been examined, etc.
' create a string array of scrollable text
' but it can be of size 1 since the LangWin structure SaveText
' and not the following array will actually hold the text being grown.
DIM Text(1 TO 1) AS STRING
' open a window with scrollable text
w1 = OpenScrollWindow(3, 3, 21, 25, 3, 15, 2, 15, Text(), 1, 2, 17, 20, 0, 1)
' open window with control buttons
w2 = BlankWin(4, 23, 12, 70, 9, 15, 2, 15, 0, 1)
x = ShowWinText(2, 3, 15, "Click ADD to manually add new text")
x = ShowWinText(3, 3, 15, "Click AUTO to automatically add new text")
' make buttons.
' save handle numbers in variables.
' these will be used later to determine which button was clicked.
xit1 = MakePushButton(5, 3, 6, "EXIT", 15, 4, 1)
add1 = MakePushButton(5, 11, 5, "ADD", 15, 4, 1)
auto1 = MakePushButton(5, 18, 6, "AUTO", 15, 4, 1)
stop1 = MakePushButton(5, 26, 6, "STOP", 15, 4, 1)
x = DeactivateButton(stop1, 1) ' deactivate the stop button
' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
WinParms(CurWinPtr, 16) = xit1' put handle of exit button into data structure
CALL ChangeButtonFocus(xit1, 0) ' reverse video the button to give it focus
'------------------------------------------------------------
' MAIN LOOP
' as long as any win is open
' wait for an event in any window, then process it
DO WHILE AnyWinOpen
' wait for an event
' win number (wn) and event code (action) returned
wn = WinEvent(action)
' test window number to see which window was current when event occurred
SELECT CASE wn
CASE w2
' determine what type of event occurred in the window w1
SELECT CASE action
CASE 1 ' close
xx = CloseWindow ' close current window (with buttons)
xx = CloseWindow ' only text win left, close it
EXIT DO
CASE 3 ' button
' see which button
SELECT CASE WinParms(CurWinPtr, 16)
CASE xit1
xx = CloseWindow ' close current window (with buttons)
xx = CloseWindow ' only text win left, close it
EXIT DO
CASE add1
T$ = "Time: " + TIME$ ' define new text
' must give text window focus BEFORE adding text
IF IsWinOpen(w1, Han) THEN ' get text win's handle
CALL NewFocusWindow(Han) ' give text win focus
END IF
x = GrowScrollText(T$) ' now add some text
' test for errors
SELECT CASE x
CASE -1 ' no scrollable text
' process this condition
' usually it means you forgot to
' call NewFocusWindow to give focus to window
' with text to be modified.
CASE -2
' scrollable text array was filled up.
' you'll probably have to activate a "continue" button,
' let the user view the text, and wait for an event.
' when the "continue" button is clicked,
' close the window with the full text array,
' open a new one in its place
' (with no text), and continue generating items
' to be displayed in the scrollable text window.
' for the demo, i'll just make some noise
' to let you know array is full.
BEEP
END SELECT
CASE auto1
' deactivate EXIT, ADD, and AUTO buttons
x = DeactivateButton(xit1, 0)
x = DeactivateButton(add1, 0)
x = DeactivateButton(auto1, 0)
' activate the stop button
x = ActivateButton(stop1, 0)
' must give text window (w1) focus BEFORE adding text.
' get it's handle, save in Han
x = IsWinOpen(w1, Han) ' get text win's handle
' loop til STOP clicked or array is filled
DO
' must give text window (w1) focus BEFORE adding text.
' window with buttons could be clicked while
' WinEvent has control for 0.5 sec, which would
' take focus away from the text window (w1) and give
' it to the window with buttons (w2). in this case,
' subsequent calls to GrowScrollText would return with
' a -1 return code. to prevent this condition,
' first make sure text window (w1) has focus.
CALL NewFocusWindow(Han) ' give text win focus
T$ = "Time: " + TIME$ ' define new text
x = GrowScrollText(T$) ' now add some text
IF x = -2 THEN EXIT DO ' bail out if array is full
IF x = -1 THEN BEEP ' this should not occur
' could insert a SLEEP 1 if necessary
aa = -999 ' set "time out" option for WinEvent
x = WinEvent(aa) ' will return in 0.5 sec if no events occur
' loop until interrupt button is clicked
LOOP UNTIL (aa = 3 AND WinParms(CurWinPtr, 16) = stop1)
BEEP ' make some noise
' activate EXIT, ADD, and AUTO buttons
x = ActivateButton(xit1, 0)
x = ActivateButton(add1, 0)
x = ActivateButton(auto1, 0)
' deactivate the stop button
x = DeactivateButton(stop1, 0)
END SELECT ' end of code to process buttons
END SELECT ' end of code to process actions in the window
END SELECT ' end of code that processes windows
LOOP
LOCATE 25, 1
CALL SetColor(15, 4)
PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
SLEEP
LOCATE 25, 1
CALL SetColor(8, 15)
PRINT STRING$(80, 178);
END SUB
'
' this subroutine illustrates the technique of opening a window,
' starting a long running task in a loop, and implementing an
' interrupt button to terminate the task.
'
' the "time out" option of WinEvent is used in the loop with the long
' running task. after a portion of the task is completed, control
' is given to WinEvent to determine if any actions have occured in
' the window. if an action occurs, WinEvent will return control as usual.
' if no actions occur in 0.5 sec, WinEvent times out and returns control
' to your code. when you get control, test to see if any actions have
' occured. if none, loop and do more work on the task at hand. if
' an action occured (i.e., the interrupt button pressed), then
' terminate the task by exiting the loop.
'
SUB IntButton
'=============================================================
' main window: text and buttons
m1 = BlankWin(9, 26, 21, 69, 9, 15, 1, 0, 1, 1)
' i'll skip the test for an error return code
' display some text in the window
d = ShowWinText(1, 2, 15, "Example of 'time out' option in WinEvent")
d = ShowWinText(2, 2, 15, "to implement an INTERRUPT button.")
d = ShowWinText(4, 2, 15, "Click Test Win button to open window.")
d = ShowWinText(5, 2, 15, "Click Start button to begin task.")
d = ShowWinText(6, 2, 15, "Click Interrupt button to terminate task.")
' put a title in window
d = ShowTitle(" SAMPLE05 ", 15, 4)
' no error tests will done for above functions
' make buttons.
' save handle numbers in variables.
' these will be used later to determine which button was clicked.
TestWin = MakePushButton(8, 10, 10, "Test Win", 15, 3, 1)
xit2 = MakePushButton(8, 23, 6, "EXIT", 15, 5, 1)
' give the exit button focus (if ENTER is hit, EXIT button will be pushed)
WinParms(CurWinPtr, 16) = xit2' put handle of exit button into data structure
CALL ChangeButtonFocus(xit2, 0) ' reverse video the button to give it focus
'=============================================================
' MAIN LOOP
' as long as any win is open
' wait for an event in any window, then process it
DO WHILE AnyWinOpen
' wait for an event
' win number (wn) and event code (action) returned
wn = WinEvent(action)
' test window number to see which window was current when event occurred
SELECT CASE wn
CASE m1 ' main window
' now determine what type of event occurred in the window w2
SELECT CASE action
CASE 1 ' close icon or ESC
x = CloseWindow
CASE 2 ' text
' no scrollable text to select in this win
CASE 3 ' button
' determine which button was clicked
' get handle number of clicked button
ButtonHandle = WinParms(CurWinPtr, 16)
' test all buttons for match
SELECT CASE ButtonHandle
CASE xit2 ' exit
xx = CloseWindow
CASE TestWin ' test window button
' open a MODAL window to illustrate use of WinEvent's
' "time out" option for implementing an interrupt button.
' i strongly recommend that the window containing
' the interrupt button be MODAL (otherwise your user
' could attempt to mouse to another window and click buttons).
' since this will be a modal window,
' actions on other windows will be ignored until this win
' closed. thus, there is no need to deactivate buttons
' in the main window to prevent the user opening another
' instance of the test window. the fact that this is a modal
' window will insure that all objects in other windows
' are ignored. we will still have to deactivate some objects
' in this window that should be ignored.
win1 = BlankWin(3, 3, 12, 40, 5, 15, 1, 0, 0, 2)
' i'll skip test for return code with error
' put some text into the window
d = ShowWinText(2, 3, 14, "Interrupt Button Example")
' make some buttons
w1strt = MakePushButton(7, 3, 7, "START", 15, 3, 1)
w1int = MakePushButton(7, 13, 11, "INTERRUPT", 15, 3, 1)
w1xit = MakePushButton(7, 27, 6, "EXIT", 15, 3, 1)
' initially, the interrupt button is inactive
d = DeactivateButton(w1int, 0)
' i'll use a technique explained in SAMPLE04 to determine
' the handle of a static text field, and re-use that
' handle to dynamically change text in the window.
' this will show progress that is being made in the
' in the window while waiting for the interrupt button
' to be clicked.
x = ShowWinText(4, 3, 15, "KNOWN VALUE") ' known text
' now scan all button text to find handle of above text
timhan = -999 ' default handle number
FOR i = 1 TO MaxButtons ' scan the entire data structure
IF ButtonsText(i) = "KNOWN VALUE" THEN ' look for text
timhan = i ' if match, save handle
EXIT FOR ' terminate search
END IF
NEXT
' this problem should not occur
' (ie, could not find specific text in ButtonsText array),
' but as safety valve, i'll test for it.
IF timhan = -999 THEN END
' at this point, timhan contains handle of text object
' that will by dynamically changed
ButtonsText(timhan) = "" ' initialize text
CALL ReShowInputField(timhan) ' update screen
ButtonsData(timhan, 4) = LEN(a$) ' update length of area
' now return to main loop and wait for an event in the
' window just opened.
END SELECT ' end of select for buttons in main
END SELECT ' end of select for main window
CASE win1 ' window where interrupt button is to be used
' only button events possible (no other objects defined)
' determine which button caused the event
SELECT CASE WinParms(CurWinPtr, 16)
CASE w1strt ' start button
' clicking the start button will begin a sample long running task.
' in my example, only the interrupt button will terminate
' the task. your code could implement a task that might terminate
' nornally if it ran long enough (like reading records from a
' file) or terminate immediately (if interrupt button is clicked).
' when the start button is clicked, the text label
' will be dynamically updated with the current time to simulate
' a task being done in a window while waiting for an
' interrupt button to be clicked.
'deactivate the start and exit buttons
d = DeactivateButton(w1strt, 0) ' deactivate the start button
d = DeactivateButton(w1xit, 0) ' deactivate the exit button
'activate the interrupt button
d = ActivateButton(w1int, 0) ' activate the interrupt button
' to implement the technique of waiting for an interrupt button,
' a loop is used where some portion of the task is done
' (like reading one record from a file, scanning one directory,
' etc.), then WinEvent is called with the action parameter set to
' -999. this will cause WinEvent to "time out" and return
' after 0.5 sec if no event is detected, that is WinEvent will
' return control after 0.5 sec if the interrupt button was
' not clicked (if an event is detected, WinEvent will return as
' soon as the event is processed). when control is returned, just
' test to see if an event occured and if it was the interrupt
' button. if no event occured, continue with the loop and
' process the next portion of the task at hand. if the task
' completes nornally, or if you detect that the interrupt button
' was clicked when returning from WinEvent, then exit the loop.
' in this example, i just loop and modify the text field with
' current time (to simulate a long running task).
' when the INTERRUPT button is clicked, processing will stop.
' there is no test for nornal completion of the simulated task.
DO ' the long running task loop
' simulate some work
ButtonsText(timhan) = TIME$ 'place current time in array
CALL ReShowInputField(timhan) 'update screen to show progress
ButtonsData(timhan, 4) = LEN(a$) ' update length of area
' since the previous commands to update text on the screen
' are so fast, i've included the following SLEEP command
' to simulate the long running task's work within the loop.
' change the amount of time to sleep to see the effect.
' unfortunately, mouse clicks made while work is done outside
' of WinEvent are not "remembered" when WinEvent gets control.
' this is because WinEvent hides/shows the mouse cursor
' which resets the press counter. thus, if the loop you
' implement (with work and a call to WinEvent) takes a long
' time to get back to WinEvent each time, the effect will be
' that clicks on the interrupt button may seem to be ignored.
' your user will have to click repeatedly on the interrupt
' button (to make sure that at least one of those clicks
' occurs while EinEvent has control). to see this effect,
' set the wait time in the following SLEEP command to 5
' or more. you'll have to click frequently on the interrupt
' button. sorry, i never said LangWin was perfect!
' to avoid this situation, try to keep the amount of work
' done in your loop as short (or efficient) as possible.
' add a SLEEP x command below to see effects of processing
' delays in the loop with WinEvent.
aa = -999 ' set "time out" option for WinEvent
x = WinEvent(aa) ' will return in 0.5 sec if no events occur
' loop until interrupt button is clicked
LOOP UNTIL aa = 3 AND WinParms(CurWinPtr, 16) = w1int
' processing was interrupted
' activate start and exit buttons and deactivate interrupt button
d = ActivateButton(w1strt, 0) ' activate the start button
d = ActivateButton(w1xit, 0) ' activate the exit button
d = DeactivateButton(w1int, 0) ' deactivate the interrupt button
CASE w1xit ' exit button
x = CloseWindow
END SELECT ' end of section to process events in modal window
END SELECT
LOOP
LOCATE 25, 1
CALL SetColor(15, 4)
PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
SLEEP
LOCATE 25, 1
CALL SetColor(8, 15)
PRINT STRING$(80, 178);
END SUB
' =====================================================
' returns type of video display
'
' return values:
' 1: black/white (could be EGA/VGA with monochrome)
' 2: CGA (with color)
' 3: EGA (with color)
' 4: VGA (with color)
' 5: MCGA (with color)
' 99: other
'
FUNCTION VidType
' quick & dirty, check &h463
DEF SEG = 0
IF PEEK(&H463) = &HB4 THEN ' see if monochrome
VidType = 1
EXIT FUNCTION
END IF
DEF SEG
' first try int 10h, function 1Ah
InRegs.ax = &H1A00
CALL INTERRUPTX(&H10, InRegs, OutRegs)
IF (OutRegs.ax AND &HFF) = &H1A THEN ' see if int 10h, funct 1Ah supported
code = (OutRegs.bx AND &HFF) ' get display code
SELECT CASE code
CASE 1 ' MDA
VidType = 1
CASE 2 ' CGA
VidType = 2
CASE 4 ' EGA color
VidType = 3
CASE 5 ' EGA b/w
VidType = 1
CASE 7 ' VGA b/w
VidType = 1
CASE 8 ' VGA color
VidType = 4
CASE 10 ' MCGA color
VidType = 5
CASE 11 ' MCGA b/w
VidType = 1
CASE ELSE
VidType = 99 ' other
END SELECT
EXIT FUNCTION
ELSE
' now try int 10h, function 12h, sub-function 10h
InRegs.ax = &H1200
InRegs.bx = &H10
CALL INTERRUPTX(&H10, InRegs, OutRegs)
IF (OutRegs.bx AND &HFF00) = 1 THEN ' see if monochrome
VidType = 1
EXIT FUNCTION
END IF
IF (OutRegs.bx AND &HFF) <> &H10 THEN ' see if BL reg changed
VidType = 3 ' EGA (not sure why it couldn't be VGA too!)
EXIT FUNCTION
END IF
VidType = 99 ' other (probably CGA or MDA)
END IF
END FUNCTION
